COMMENT ⊗   VALID 00007 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY
C00003 00003	!	define reserved token codes 
C00014 00004	!	tables to set up reserved words 
C00017 00005	! 	decoding a token to give its various parameters 
C00019 00006	!	procedure parse itself
C00023 00007	!	preparse,rparse
C00024 ENDMK
C⊗;
ENTRY;
BEGIN "PARSE"
DEFINE $$PRGID=TRUE;	DEFINE $PARSE=TRUE;	
REQUIRE "HEADER.SAI" SOURCE_FILE;

DEFINE #TOP=1;	! complain if $COMPILE≠0;
DEFINE #NEXPND=2; ! sets NOEXPAND←TRUE;
DEFINE #CMPD=4;	! set $COMPILE ← $COMPILE + 1 ;
DEFINE #NOTTOP='10;	! complain if $COMPILE=0 ;
DEFINE #SEMICOL='20;	! do a semicolonread;
!	define reserved token codes ;

!	format is as follows:
	ZZ(symbol, opcode number, precedence level)	for operators
	XX(flag,  statement reserved word,  parsing procedure to call)
				where flag indicates whether this statement
				is available in the current version
	XXZZ(flag, symbol, parsing procedure, opcode number, precedence level)
				for symbols which are both operators and
				first words of statements ;
define tokencodes "[][]" =[
ZZ("↓",		DOWNARROW_X,	PF_XX,	0)
ZZ("∧",		and_X,		BFACT_XX,	0)
ZZ("¬",		not_X,		PF_XX,	0)
ZZ("⊗",		xor_X,		BEFACT_XX,	0)
ZZ("→",		frontarrow_X,	FACTOR_XX,	0)
ZZ("≠",		sne_X,		BTERM_XX,	0)
ZZ("≤",		sle_X,		BTERM_XX,	0)
ZZ("≥",		sge_X,		BTERM_XX,	0)
ZZ("≡",		eqv_X,		EXP_XX,	0)
ZZ("∨",		or_X,		BEFACT_XX,	0)
ZZ("#",		pplus_X,	AEXP_XX,	0)
ZZ("$",		DOLLAR_X,	PF_XX,	0)
ZZ("α",		ALPHA_X,	PF_XX,	0)
ZZ(["("],	LPAREN_X,	PF_XX,	0)
ZZ("*",		times_X,	TERM_XX,	0)
ZZ("+",		Plus_X,		AEXP_XX,	0)
ZZ("-",		minus_X,	AEXP_XX,	0)
ZZ(".",		vdot_X,		TERM_XX,	0)
ZZ("/",		sdiv_X,		TERM_XX,	0)
ZZ("<",		slt_X,		BTERM_XX,	0)
ZZ("=",		seq_X,		BTERM_XX,	0)
ZZ(">",		sgt_X,		BTERM_XX,	0)
XX(TRUE,	ABORT,		ABORTPROC,	0)
ZZ("ACOS",	acos_X,		PF_XX,	0)
XX(TRUE,	AFFIX,		AFFIXPROC,	0)
XX(TRUE,	ALL,		NOTAVAILCALL,	0)
ZZ("AND",	aand_X,		BFACT_XX,	0)
XX(TRUE,	APPROACH,	NOTAVAILCALL,	0)
XX(TRUE,	ARRAY,		NOTAVAILCALL,	0)
ZZ("ASIN",	asin_X,		PF_XX,	0)
ZZ("ATAN2",	atan2_X,	PF_XX,	0)
ZZ("AXIS",	axis_X,		PF_XX,	0)
XX(TRUE,	BAIL,		BAILCALL,	0)
XX(TRUE,	BEGIN,		BEGINPROC,	#CMPD)
XX(#MOVE,	BY,		DEFLT("BY"),	0)
XX(TRUE,	CASE,		CASEPROC,	#CMPD)
XX(#MOVE,	CENTER,		CENTERPROC,	0)
XX(TRUE,	CLOCKWISE,	NOTAVAILCALL,	0)
XX(TRUE,	CLOSE,		CLOSEPROC,	0)
XX(TRUE,	COBEGIN,	COBEGINPROC,	#CMPD)
XX(TRUE,	COEND,		ENDPROC("COEND"),	#NOTTOP)
XX(TRUE,	COMMENT,	[READTO(";")],	0)
XX(FALSE,	CONSOLE,	NOTAVAILCALL,	0)
ZZ("CONSTRUCT",	construct_X,	PF_XX,	0)
ZZ("COS",	cos_X,		PF_XX,	0)
XX(TRUE,	COUNTER_CLOCKWISE,	NOTAVAILCALL,	0)
XX(TRUE,	DDT,		DDTPROC,	0)
XX(TRUE,	DEFINE,		DEFINECALL,	#NEXPND)
XX(TRUE,	DELETE,		DELETECALL,	#NEXPND)
XX(TRUE,	DEPARTURE,	NOTAVAILCALL,	0)
XX(TRUE,	DISABLE,	ENBLEPROC(FALSE),	0)
XX(#DISPL,	DISPLAY,	DISPLAYCALL,	#TOP+#NEXPND)
ZZ("DIV",	div_X,		TERM_XX,	0)
XX(TRUE,	DO,		DOPROC,		#CMPD)
XX(#MOVE,	DRIVE,		DRIVEPROC,	0)
XX(TRUE,	DUMP_VARIABLES,	DUMPPROC(NAMEFILE),	#TOP)
XX(TRUE,	DURATION,	NOTAVAILCALL,	0)
XX(TRUE,	ECHOOFF,	[FILEPRINT←FALSE],	0)
XX(TRUE,	ECHOON,		[FILEPRINT←TRUE],	0)
XX(TRUE,	EDIT,		EDITCALL,	#TOP+#NEXPND)
XX(TRUE,	EEDIT,		EEDITCALL,	#TOP+#NEXPND)
XX(TRUE,	ENABLE,		ENBLEPROC(TRUE),	0)
XX(TRUE,	END,		ENDPROC,	#NOTTOP)
ZZ("EQV",	eeqv_X,		EXP_XX,	0)
XX(TRUE,	ERROR,		NOTAVAILCALL,	0)
ZZ("EVAL",	EVAL_X,		PF_XX,	0)
XX(TRUE,	EVENT,		DECLPROC(#EV),	0)
XX(TRUE,	EXIT,		EXITCALL,	#TOP+#SEMICOL)
ZZ("EXP",	exp_X,		PF_XX,	0)
XX(FALSE,	FCONSTRUCT,	FCONSTRUCTPROC,	0)
XX(TRUE,	FOR,		FORPROC,	#CMPD)
XX(TRUE,	FORCE,		NOTAVAILCALL,	0)
XXZZ(TRUE,	FRAME,	DECLPROC(#FR),	FRAME_X,	PF_XX,	0)
XX(not #nofunct,	FUNCTION,	FUNCTPROC,	0)
XX(#GATHER,	GATHER,		GATHERPROC,	0)
XX(#GATHER,	GRAPH,		GRAPHCALL,	#TOP)
XX(TRUE,	HELP,		HELPCALL,	0)
XX(TRUE,	IF,		IFPROC,		#CMPD)
ZZ("INSCALAR",	inscalar_X,	PF_XX,	0)
ZZ("INT",	int_X,		PF_XX,	0)
XX(TRUE,	INTO,		NOTAVAILCALL,	0)
ZZ("INV",	rinv_X,		PF_XX,	0)
XX(TRUE,	LABEL,		SIMPLEDECL(#CM),	0)
XX(TRUE,	LOAD_VARIABLES,	LOADPROC(NAMEFILE),	#TOP)
ZZ("LOG",	log_X,		PF_XX,	0)
ZZ("MAX",	max_X,		TERM_XX,	0)
ZZ("MIN",	min_X,		TERM_XX,	0)
ZZ("MOD",	mod_X,		TERM_XX,	0)
XX(#MOVE,	MOVE,		MOVEPROC,	0)
XX(#MOVE,	MOVEX,		AXMOVPROC,	0)
XX(#MOVE,	MOVEY,		AXMOVPROC,	0)
XX(#MOVE,	MOVEZ,		AXMOVPROC,	0)
XX(#DISPL,	NODISPLAY,	NODISPLAYCALL,	#TOP)
XX(#DISPL,	NOUPDATE,	[$ALLOW←$ALLOW+1],	#TOP)
XX(TRUE,	ON,		ONPROC,	0)
XX(#MOVE,	OPEN,		OPCLPROC(TOKEN),	0)
XX(TRUE,	OPERATE,	OPERPROC,	0)
ZZ("OR",	oor_X,		BEFACT_XX,	0)
XXZZ(TRUE,	ORIENT,	COORDPROC(0,#RT),	ORIENT_X,	PF_XX,	0)
XX(#MOVE,	PARK,		PARKINGPROC,	0)
XX(TRUE,	PAUSE,		PAUSEPROC,	0)
XX(TRUE,	PHOTO,		PHOTOCALL(NAMEFILE),	#TOP)
XXZZ(TRUE,	POS,	COORDPROC(0,#VT),	POS_X,	PF_XX,	0)
XX(TRUE,	PRINT,		PRINTPROC,	0)
XX(TRUE,	PROCEDURE,	PROCDECLPROC,	#CMPD+#TOP)
XX(TRUE,	PROMPT,		PROMPTPROC,	0)
XX(TRUE,	QBAIL,		QBLCALL,	0)
XX(TRUE,	QDELETE,	DELETECALL(TRUE),	#TOP+#NEXPND)
XX(#OUTPT,	QREAD,		READCALL(FALSE),	#TOP+#NEXPND)
ZZ("QUERY",	qquery_X,	PF_XX,		0)
XX(#OUTPT,	READ,		READCALL,	#TOP+#NEXPND)
XX(TRUE,	READMESSAGE,	READMESSCALL,	#TOP+#SEMICOL)
XX(#WRIST,	READWRIST,	READWRISTPROC,	#TOP)
XX(TRUE,	REDEFINE,	DEFINECALL(TRUE),	#NEXPND)
XX(#DISPL,	REDISPLAY,	REDISPLAYCALL,	#TOP)
XX(TRUE,	REFERENCE,	NOTAVAILCALL,	0)
ZZ("REL",	rel_X,		FACTOR_XX,	0)
XX(TRUE,	RENAME,		RENAMCALL,	#TOP+#NEXPND)
XX(TRUE,	REQUIRE,	REQUIRECALL,	0)
XX(TRUE,	RESETSTATUS,	SETSTATUSCALL(0),	#TOP)
XX(TRUE,	RESUME_MESSAGE,	RSUMEMESSCALL,	#TOP)
XX(TRUE,	RETRY,		RETRYPROC,	0)
XX(TRUE,	RETURN,		RETURNPROC,	#NOTTOP)
XXZZ(TRUE,	ROT,		DECLPROC(#RT),	ROT_X,	PF_XX,	0)
ZZ("RUNTIME",	runtime_X,		PF_XX,	0)
XX(TRUE,	SAVECOREIMAGE,	SAVECORECALL(NAMEFILE),	#TOP)
XX(TRUE,	SCALAR,		DECLPROC(#SC),	0)
XX(TRUE,	SETBASE,	SETBASEPROC,	0)
XX(TRUE,	SETSTATUS,	SETSTATUSCALL(1),	#TOP+#NEXPND)
XX(TRUE,	SETSTIFF,	SETSTIFFPROC,	0)
XX(TRUE,	SHOW,		SHOWCALL,	#TOP+#NEXPND)
XX(TRUE,	SIGNAL,		SIGWAITPROC(TRUE),	0)
ZZ("SIN",	sin_X,		PF_XX,	0)
XX(TRUE,	SPEED_FACTOR,	SETSPEEDPROC,	0)
ZZ("SQRT",	sqrt_X,		PF_XX,	0)
XX(TRUE,	STOP,		STOPPROC,	0)
XX(TRUE,	STOPMESSAGE,	STOPMESSCALL,	#TOP+#SEMICOL)
XX(TRUE,	STOP_WAIT_TIME,	NOTAVAILCALL,	0)
XX(TRUE,	SUBTREE,	NOTAVAILCALL,	0)
ZZ("TAN",	tan_X,		PF_XX,	0)
XX(#GATHER,	TGRAPH,		TGRAPHCALL,	#TOP)
XX(#MOVE,	TO,		DEFLT("TO"),	0)
XX(TRUE,	TORQUE,		NOTAVAILCALL,	0)
XXZZ(TRUE,	TRANS,		DECLPROC(#TR),	TRANS_X,	PF_XX,	0)
XX(FALSE,	UNCONSOLE,	NOTAVAILCALL,	0)
XX(TRUE,	UNFIX,		UNFIXPROC,	0)
ZZ("UNIT",	uvect_X,	PF_XX,	0)
XX(#DISPL,	UPDATE,		[$ALLOW←$ALLOW-1],	0)
XX(TRUE,	VALUE,		NOTAVAILCALL,	0)
XXZZ(TRUE,	VECTOR,	DECLPROC(#VT),	VECTOR_X,	PF_XX,	0)
XX(TRUE,	VELOCITY,	NOTAVAILCALL,	0)
XX(TRUE,	VT05,		NOTAVAILCALL,	0)
XX(TRUE,	VT05_OFF,	VT05PROC(1),	0)
XX(TRUE,	VT05_ON,	VT05PROC(0),	0)
XX(TRUE,	WAIT,		SIGWAITPROC(FALSE),	0)
XX(TRUE,	WHILE,		WHILEPROC,	#CMPD)
XX(TRUE,	WRIST,		WRISTPROC,	0)
XX(#OUTPT,	WRITE,		WRITCALL,	#TOP+#NEXPND)
ZZ("WRT",	wrt_X,		FACTOR_XX,	0)
XXZZ(TRUE,	XCOORD,	COORDPROC(1,#SC),	COORDX_X,	PF_XX,	0)
XX(TRUE,	XFOO1,		FOOCALL(1),	0)
XX(TRUE,	XFOO2,		FOOCALL(2),	0)
XX(TRUE,	XFOO3,		FOOCALL(3),	0)
XX(TRUE,	XFOO4,		FOOCALL(4),	0)
XX(TRUE,	XFOO5,		FOOCALL(5),	0)
XX(TRUE,	XFOO6,		FOOCALL(6),	0)
XX(TRUE,	XFOO7,		FOOCALL(7),	0)
XX(TRUE,	XFOO8,		FOOCALL(8),	0)
XX(TRUE,	XFOO9,		FOOCALL(9),	0)
ZZ("XOR",	xxor_X,		BEFACT_XX,	0)
XXZZ(TRUE,	YCOORD,	COORDPROC(2,#SC),	COORDY_X,	PF_XX,	0)
XXZZ(TRUE,	ZCOORD,	COORDPROC(3,#SC),	COORDZ_X,	PF_XX,	0)
ZZ("↑",		stos_X,		FACTOR_XX,	0)
ZZ("|",		MAGNITUDE_X,	PF_XX,	0)
];

!	tables to set up reserved words ;

	! count number of reserved tokens ;
define res_count = 0;
redefine zz(symb,opnum,precedence_level)"[][]"=[redefine res_count=res_count+1;];
redefine xxzz(#flag,str,parsing_proc,opnum,precedence_level)"[][]"
		=[redefine res_count=res_count+1;];
redefine xx(#flag, str, parsing_proc)"[][]"=[redefine res_count=res_count+1;];

	! **************************************** ;
	! *****;	tokencodes;	! ******** ;
	! at this point res_count contains actual # of reserved words ;


	! set up a string array of reserved tokens  in RESCODE ;
redefine xx(#flag, str, parsing_proc)"[][]"=["str", ];
redefine xxzz(#flag,str,parsing_proc,opnum,precedence_level)"[][]"=["str",];
redefine zz(symb,opnum,precedence_level)"[][]"=[symb,];

preload_array( rescode , tokencodes , string , 1 , res_count);

	! set up an integer array of codes  for the reserved tokens ;
define xx_count=0;
redefine xx(#flag, str, parsing_proc)"[][]"=[
	redefine xx_count=xx_count+1; 
	xx_count*(#OPERATORS+1)*#DTYPE, ];
redefine zz(symb,opnum,precedence_level)=
	[opnum*#DTYPE+precedence_level,];
redefine xxzz(#flag,str,parsing_proc,opnum,precedence_level)"[][]"=[
	redefine xx_count=xx_count+1;
	(xx_count*(#OPERATORS+1)+opnum)*#DTYPE+precedence_level, ];

	! ***** now set up the array as TCODES  ***** ;
preload_array(tcodes, tokencodes, integer, 1, res_count);

redefine xx(#flag, str, parsing_proc,#cond)"[][]"=[#cond,];
redefine zz(symb,opnum,precedence_level,#cond)=[#cond,];
redefine xxzz(#flag,str,parsing_proc,opnum,precedence_level,#cond)"[][]"=[#cond,];

preload_array(ccodes,tokencodes,integer,1,res_count);
! 	decoding a token to give its various parameters ;
!	res_class = class of reserved word, 0 if strict operator
	token_class = operator class
	token_index = precedence level ;

INTEGER RES_ENTRY;

INTERNAL INTEGER PROCEDURE DECSTR(string VAL);
	BEGIN INTEGER L,M,U,I1,I2; STRING S1,S2;
	L←1; U←res_count;
	DO begin M←(U+L)/2;
	    CASE COMPEQU(rescode[M],VAL)+1 OF
		BEGIN
		[-1+1]	U←M-1;
		[0+1]	begin res_class←TCODES[M] DIV( (#OPERATORS+1)*#DTYPE);
				tokenclass←tcodeS[m] mod #dtype;
				tokenindex← (tcodeS[m] div #dtype) mod (#OPERATORS+1);
				RETURN(RES_ENTRY←M);
			end;
		[1+1]	L←M+1
		END;
	   end UNTIL L>U;
	res_class←tokenclass←tokenindex←0;
	RETURN(RES_ENTRY←0);
	END;

!	procedure parse itself;

INTERNAL RECURSIVE RPTR(EXPR$)PROCEDURE PARSE;
BEGIN "PARSER"
	$$PCODE←NULL_RECORD;		! initialize at beginning of statement;
	NOEXPAND←FALSE;			! enable macro expansions ;
	GTOKEN;				! reads first token;
	STBEGIN←FALSE;			! acknowledge that no longer beginning
					  of statement;
	IF "A"≤ TOKEN ≤"Z" THEN
IF res_class=0 THEN ASSIGNPROC
ELSE BEGIN
	BOOLEAN INCR_COM;
	IF ($COMPILE≠0)AND(CCODES[RES_ENTRY] LAND #TOP) THEN
		ERROR(TOKEN,":: is a top level command only and cannot be used in compound statements");
	IF ($COMPILE=0)AND(CCODES[RES_ENTRY] LAND #NOTTOP) THEN
		ERROR(TOKEN,":: is valid only inside a block");
	IF (INCR_COM←CCODES[RES_ENTRY] LAND #CMPD) THEN $COMPILE←$COMPILE+1;
	IF CCODES[RES_ENTRY] LAND #NEXPND THEN NOEXPAND←TRUE;
	IF CCODES[RES_ENTRY] LAND #SEMICOL THEN SEMICOL_READ;
	   CASE res_class of
   	        BEGIN "CASE"
		redefine xx(#flag, str,oper)"[][]"=[
			ifc #flag thenc ; oper elsec ; notavailcall endc];
		redefine xxzz(#flag, str,oper,arg1,arg2)"[][]"=[
			 ; oper ];
		redefine zz(arg1,arg2,arg3)"[][]"=[];
		ASSIGNPROC
		tokencodes
	        END "CASE";
	IF INCR_COM THEN $COMPILE←$COMPILE-1;
     END
ELSE IF TOKEN=";" OR TOKEN=NULL THEN
		BEGIN IF $COMPILE THEN STOKEN←TRUE END
ELSE IF TOKEN="?" THEN PRINT(#VERSION)
ELSE	IFC #ARROW THENC
	IF TOKEN="↑" 
	   THEN BEGIN $ARROW←$ARROW+20; UPDATE; END
	ELSE IF TOKEN="↓" 
	   THEN BEGIN $ARROW←$ARROW-20; UPDATE; END
	ELSE IF #TOKEN=INT_TYPE
	   THEN BEGIN
		INTEGER NUM;
		NUM←INTSCAN(TOKEN,$BRCHR);
		GTOKEN;
		IF TOKEN="↓" THEN $ARROW←$ARROW-NUM*20
		   ELSE IF TOKEN="↑" THEN $ARROW←$ARROW+NUM*20
		   ELSE	ERROR("unrecognized instruction");
		UPDATE;
		END
           ELSE ENDC 
		ERROR("ERROR: Can't begin statement with ",TOKEN);

	IF NOT $COMPILE
	   THEN BEGIN "interpret it"
		$ALLOW←$ALLOW+1;
		IF $$PCODE THEN $EXECUTE($$PCODE);
		$$PCODE←NULL_RECORD;
		$ALLOW←$ALLOW-1;
		IFC #DISPL THENC UPDATE; ENDC
		END;
	RETURN($$PCODE);
END "PARSER";
!	preparse,rparse;

INTERNAL PROCEDURE PREPARSE;
	BEGIN
	$COMPILE←0;		! set interpreter mode;
	$LEVEL←0;		! indicate it is top level ;
	$TMPOFF←$SYMOFF;	! reinitialize the maximum offset;
	CURPROC←NULL_RECORD;	! we are outside a procedure ;
	CURBLOCK←NULL_RECORD;	! we are ouside a block ;
	STBEGIN←TRUE;		! waiting for a new command;
	$CLNSAVE←NULL;		! get rid of the saved string;
	$ERRCMON←FALSE;
	$ERRLEVEL←0;
	END;

END "PARSE";